home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / comcof.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  2.8 KB  |  103 lines
  1.       subroutine comcof
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine calculates the timestep-dependent terms used in the
  5. c numerical integration.
  6. c
  7. c spice version 2g.6  sccsid=tabinf 3/15/83
  8.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  9.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  10.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  11.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  12.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  13.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  14.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  15.      7   irowno,jcolno,nttbr,nttar,lvntmp
  16. c spice version 2g.6  sccsid=status 3/15/83
  17.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  18.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  19.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  20. c spice version 2g.6  sccsid=flags 3/15/83
  21.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  22.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  23. c spice version 2g.6  sccsid=blank 3/15/83
  24.       common /blank/ value(200000)
  25.       integer nodplc(64)
  26.       complex cvalue(32)
  27.       equivalence (value(1),nodplc(1),cvalue(1))
  28.       dimension gmat(7,7)
  29. c
  30. c  compute coefficients for particular integration method
  31. c
  32.       if (method.ne.1) go to 5
  33.       if (iord.eq.1) go to 5
  34. c...  trapezoidal method
  35.       ag(1)=1.0d0/delta/(1.0d0-xmu)
  36.       ag(2)=xmu/(1.0d0-xmu)
  37.       go to 200
  38. c
  39. c  construct gear coefficient matrix
  40. c
  41.     5 istop=iord+1
  42.       call zero8(ag,istop)
  43.       ag(2)=-1.0d0
  44.       do 10 i=1,istop
  45.       gmat(1,i)=1.0d0
  46.    10 continue
  47.       do 20 i=2,istop
  48.       gmat(i,1)=0.0d0
  49.    20 continue
  50.       arg=0.0d0
  51.       do 40 i=2,istop
  52.       arg=arg+delold(i-1)
  53.       arg1=1.0d0
  54.       do 30 j=2,istop
  55.       arg1=arg1*arg
  56.       gmat(j,i)=arg1
  57.    30 continue
  58.    40 continue
  59. c
  60. c  solve for gear coefficients ag(*)
  61. c
  62. c
  63. c  lu decomposition
  64. c
  65.       do 70 i=2,istop
  66.       jstart=i+1
  67.       if (jstart.gt.istop) go to 70
  68.       do 60 j=jstart,istop
  69.       gmat(j,i)=gmat(j,i)/gmat(i,i)
  70.       do 50 k=jstart,istop
  71.       gmat(j,k)=gmat(j,k)-gmat(j,i)*gmat(i,k)
  72.    50 continue
  73.    60 continue
  74.    70 continue
  75. c
  76. c  forward substitution
  77. c
  78.       do 90 i=2,istop
  79.       jstart=i+1
  80.       if (jstart.gt.istop) go to 90
  81.       do 80 j=jstart,istop
  82.       ag(j)=ag(j)-gmat(j,i)*ag(i)
  83.    80 continue
  84.    90 continue
  85. c
  86. c  backward substitution
  87. c
  88.       ag(istop)=ag(istop)/gmat(istop,istop)
  89.       ir=istop
  90.       do 110 i=2,istop
  91.       jstart=ir
  92.       ir=ir-1
  93.       do 100 j=jstart,istop
  94.       ag(ir)=ag(ir)-gmat(ir,j)*ag(j)
  95.   100 continue
  96.       ag(ir)=ag(ir)/gmat(ir,ir)
  97.   110 continue
  98. c
  99. c  finished
  100. c
  101.   200 return
  102.       end
  103.